Clique abaixo para selecionar qual deseja visualizar.
Este estudo, através de dados do IBGE de 1991, 2000 e 2010, buscou criar métricas as quais possibilitaram sugestão para abertura de um novo empreendimento no varejo em municípios promissores. A abordagem partiu da premissa que certos fatores são determinantes no sucesso de um negócio no varejo. Enquanto outros simplesmente têm pouca relevância ou nenhuma. O estudo realizado não buscou provar a afirmativa anterior, mas imaginar um cenário que essa premissa seja real e possibilite uma sugestão de localização para abertura de um novo empreendimento. Sem critérios externos que possibilitem fudamentação do “sucesso” do estabelecimento, estabeleceu-se que as métricas de população e renda per capita são determinantes. Através da integração de séries temporais (ARIMA) e redes neurais (Keras), modelos que partem de pressupostos distintos. Implicando, de certa forma, uma “concordância” dentre o que foi predito por modelos, o presente estudo foi proposto. Enquanto ARIMA projetou dados para o ano de 2020, Keras aplicou modelo aprendido nos anos de 1991, 2000 e 2010 nos dados projetados pelo ARIMA. Por fim, foram selecionados dados “concordantes” entre os modelos e elencado as três melhores cidades a partir de filtros e dois perfís de investidor. Um perfil busca alta margem de lucro em detrimento do volume de vendas, o outro busca alto volume de vendas em detrimento da margem de lucro.
Imaginando um cenário que uma varejista tem interesse em abrir novos empreendimentos em municípios brasileiros. E utilizando dados do IBGE de 1991, 2000 e 2010. Qual sugestão de município seria possível? Por que?
Se tratando de um estudo primário e de escopo limitado a dados do IBGE. Foi buscado, neste estudo, realizar previsões para o ano de 2020 (ARIMA) e “validá-los” com Keras.
Possuiu como objetivos gerais:
Possuiu como objetivos específicos:
Foi escolhido ARIMA porque ele é especialmente eficaz na modelagem de tendências e padrões temporais lineares nos dados.
Já Keras, foi escolhido por sua capacidade de lidar com relações complexas e não-lineares, principalmente entre diferentes características ou variáveis no conjunto de dados.
Em outras palavras, o objetivo é o mesmo, porém utilizando caminhos diferentes. Dessa forma, aferindo uma “concordância” dentre as predições de ambos modelos. Utilizando ARIMA e Keras combinados, possibilitam inferir uma (des)validação mútua das previsões.
Para exibir as bibliotecas e ferramentas utilizadas clique no botão:
Para exibir detalhes sobre o Data Frame clique no botão:
As variáveis são, respectivamente…:
# Separando por anos
df_1991 <- data.frame(df_raw[df_raw$ANO == 1991,])
df_2000 <- data.frame(df_raw[df_raw$ANO == 2000,])
df_2010 <- data.frame(df_raw[df_raw$ANO == 2010,])Checando se os data frames são equivalentes
# Checando se os dataframes têm entradas idênticas (Em particular os municípios).
## Checando se colunas têm o mesmo tamanho
if (all(length(df_1991$NOMEMUN) == length(df_2000$NOMEMUN), length(df_1991$NOMEMUN) == length(df_2010$NOMEMUN))) {
## Checando se colunas têm o mesmo valor (municípios)
if (identical(sort(df_1991$NOMEMUN), sort(df_2000$NOMEMUN)) &&
identical(sort(df_2000$NOMEMUN), sort(df_2010$NOMEMUN)))
{cat("Valores iguais.")
} else {cat("Alguns valores diferentes.")
}} else {cat("Tamanhos diferentes")}## Valores iguais.
if (identical(df_1991$NOMEMUN, df_2000$NOMEMUN) && identical(df_2000$NOMEMUN, df_2010$NOMEMUN)) {cat("Nomes e posições exatamente iguais.")}## Nomes e posições exatamente iguais.
Excluindo dados irrelevantes no momento.
# Selecionando colunas de interesse e isolando (Por index do município)
df_1991_ByMdx <- data.frame(df_1991[,c(16,6,7,8,9,10,11,12,13,14,15,17,18)])
df_2000_ByMdx <- data.frame(df_2000[,c(16,6,7,8,9,10,11,12,13,14,15,17,18)])
df_2010_ByMdx <- data.frame(df_2010[,c(16,6,7,8,9,10,11,12,13,14,15,17,18)])consolidado <- data.frame(rbind(df_1991_ByMdx,
df_2000_ByMdx,
df_2010_ByMdx))
# Atribuindo para objeto sem Index do Município
df_keras <- data.frame(consolidado[,-1])
df_ranked <- data.frame(df_keras[,1:7])
df_kerasAnálise preliminar de correlação nos anos de 1991, 2000 e 2010:
# Selecionando variáveis
cor_consolidado <- cor(consolidado[, c("AREA_KM2","KM_DIST_CAP",
"ESPVIDA","FECTOT","T_ENV","GINI",
"PIND","RDPC","PESO15","PESOTOT",
"DEM_DEMO","TXDSEMP")])
# Arredondando resultado
cor_consolidado <- round(cor_consolidado,2)
# Heatmap
G_HM_cor_cons <- plot_ly(
type = "heatmap",
colorscale = "Portland",
z = cor_consolidado,
x = colnames(cor_consolidado),
y = rownames(cor_consolidado),
zmin = -1,
zmax = 1,
reversescale = TRUE
) %>% layout(
title = "Matriz de Correlação",
font = list(color = '#FFFFFF'),
paper_bgcolor = "#222222",
showlegend = FALSE
)
# Exibindo anotações no gráfico onde valor diferente de 1.
for (nr in 1:nrow(cor_consolidado)) {
for (nc in 1:ncol(cor_consolidado)) {
if (cor_consolidado[nr, nc] != 1) {
G_HM_cor_cons <- G_HM_cor_cons %>%
add_annotations(
text = round(cor_consolidado[nr, nc], 6),
x = colnames(cor_consolidado)[nc],
y = rownames(cor_consolidado)[nr],
showarrow = FALSE,
font = list(size = 14, color = "white"))}}}
G_HM_cor_consEmbora o dado acima seja rico em informações socio-econômicas, neste estudo foi selecionado RDPC, PESOTOT e DEM_DEMO.
O código abaixo seleciona cada município individualmente no ano de 1991, 2000 e 2010. E baseado nessa organização cronológica linear, projeta dados para 2020.
# Indexando ano
df_dec <- cbind(df_raw[2], df_keras)
# Removendo Areas
arima_df <- df_dec[, c(1,4,5,6,7,8,9,10,11,12,13)]
# Separando as décadas
arima_1991 <- data.frame(arima_df[arima_df$ANO == 1991,])
arima_2000 <- data.frame(arima_df[arima_df$ANO == 2000,])
arima_2010 <- data.frame(arima_df[arima_df$ANO == 2010,])
# Reset para debug
arima_2020 <- arima_2010[1,] # Adiciona linha e header
arima_2020 <- arima_2020[-nrow(arima_2020),] # Remove linha e mantém header
A_arima_2020 <- arima_2010[1,] # Adiciona linha e header
A_arima_2020 <- A_arima_2020[-nrow(A_arima_2020),] # Remove linha e mantém header
# Para cada elemento em cada linha do df_1991_1:
for (k in seq_len(nrow(arima_1991))) {
# Seleciona linhas
df_temp_forecast <- arima_1991[k,]
df_temp_forecast <- rbind(df_temp_forecast, arima_2000[k,])
df_temp_forecast <- rbind(df_temp_forecast, arima_2010[k,])
arima_2020 <- arima_2010[k,] # Apenas pela estrutura, será sobrescrito.
arima_2020$ANO[1] <- 2020
# Colunas para iteração
cols_var <- c("ESPVIDA","FECTOT", "T_ENV","GINI","PIND",
"RDPC","PESO15","PESOTOT","DEM_DEMO","TXDSEMP")
for (i in cols_var) {
arima_2020[[i]][1] <- mean(df_temp_forecast[[i]]) # 0 ou media
temp_col <- df_temp_forecast[[i]] # seleção de coluna predição
try({ temp_line <- arima(temp_col, order = c(0,0,1))},silent = TRUE)
forecast_2020 <- forecast(temp_line, h = 1) # h = 1 (2020)
arima_2020[[i]][1] <- forecast_2020$mean[1]} # Resultado a se guardar
# Joga resultado para df_2020_1
A_arima_2020 <- rbind(A_arima_2020, arima_2020[1, ])
arima_2020 <- arima_2020[-nrow(arima_2020),]
# Debug para acompanhamento
if (k %% 500 == 0) {print(k)}
else if (k == 5565) {print("Concluído")}}## [1] 500
## [1] 1000
## [1] 1500
## [1] 2000
## [1] 2500
## [1] 3000
## [1] 3500
## [1] 4000
## [1] 4500
## [1] 5000
## [1] 5500
## [1] "Concluído"
# Exportando para csv
write.csv(A_arima_2020, "Arima_IBGE_2020", row.names = FALSE)
write.csv(A_arima_2020, "Arima_IBGE_2020_RowName", row.names = TRUE)Com as projeções do ARIMA para um IBGE de 2020, os valores são consolidados para que possam ser aplicado a seguir pelo Keras.
## [1] FALSE
Arima_Prdct <- data.frame(Arima_Bkp)
# Padronizando data frames
# Inserindo variáveis
Arima_Prdct$AREA_KM2 <- df_keras$AREA_KM2[1:5565]
Arima_Prdct$KM_DIST_CAP <- df_keras$KM_DIST_CAP[1:5565]
# Reordena e não seleciona $ANO de 2020
Arima_Prdct <- Arima_Prdct %>%
select(c(
"AREA_KM2", "KM_DIST_CAP","ESPVIDA", "FECTOT", "T_ENV",
"GINI","PIND","RDPC","PESO15","PESOTOT","DEM_DEMO","TXDSEMP"
))Tendo projetado dados para 2020 com ARIMA (utilizando os anos de 1991, 2000 e 2010). Agora foi treinado um modelo para que aplique posteriormente em 2020. Isto é:
Clique acima para selecionar qual deseja visualizar.
# Selecionando target
x <- df_keras[, c("AREA_KM2", "KM_DIST_CAP", "ESPVIDA", "FECTOT", "T_ENV",
"GINI", "PIND","PESO15","PESOTOT","DEM_DEMO","TXDSEMP")]
y <- df_keras$RDPC
# Normalização dos dados
x <- scale(x)
# Definindo o modelo DNN
model_keras <- keras_model_sequential()
model_keras %>%
layer_dense(units = 64, activation = 'relu', input_shape = dim(x)[2]) %>%
layer_dense(units = 64, activation = 'relu') %>%
layer_dense(units = 1)
# Compilando modelo
model_keras %>% compile(
optimizer = optimizer_rmsprop(),
loss = 'mse',
metrics = c('mae')
)
# Treinamento
history <- model_keras %>% fit(
x, y,
epochs = 100,
validation_split = 0.2, # Split treinamento/validação
verbose = 0 # Ocultar Epoch's
)
# Desempenho do modelo
metrics <- model_keras %>% evaluate(x, y)## 522/522 - 1s - loss: 4030.0703 - mae: 35.6811 - 564ms/epoch - 1ms/step
## [1] "Mean Absolute Error (MAE): 35.6810684204102"
## [1] "Mean Squared Error (MSE): 4030.0703125"
## loss mae
## 4030.07031 35.68107
# Análise Comparativa
# Predições realizadas (Para ranking)
predicoes_RDPC <- model_keras %>% predict(x)## 522/522 - 1s - 558ms/epoch - 1ms/step
# Df pred/real
comparativo_RDPC <- data.frame(Previsoes = predicoes_RDPC, Real = y)
# Dispersão
plot(comparativo_RDPC$Real, comparativo_RDPC$Previsoes,
xlab = c("RDPC Real", metrics),
ylab = "Previsões do Modelo",
main = "Comparação entre Previsões e Valores Reais")# Keras RDPC (Ranking dos Municípios)
df_ranked$Pred_RDPC_Rnk <- predicoes_RDPC
df_ranked$PESO15 <- df_keras$PESO15
summary(predicoes_RDPC)## V1
## Min. : 37.28
## 1st Qu.: 178.23
## Median : 301.47
## Mean : 342.10
## 3rd Qu.: 475.36
## Max. :1524.72
# Setup
x_Arima_Prdct <- Arima_Prdct[, c("AREA_KM2", "KM_DIST_CAP", "ESPVIDA",
"FECTOT", "T_ENV", "GINI","PIND","PESO15",
"PESOTOT","DEM_DEMO","TXDSEMP")]
x_Arima_Prdct <- scale(x_Arima_Prdct)
# Previsões
predicoes_RDPC_Arima_Prdct <- model_keras %>% predict(x_Arima_Prdct)## 174/174 - 0s - 180ms/epoch - 1ms/step
# Selecionando target
x <- df_keras[, c("AREA_KM2", "KM_DIST_CAP", "ESPVIDA", "FECTOT", "T_ENV",
"GINI", "PIND","RDPC","PESO15","DEM_DEMO","TXDSEMP")]
y <- df_keras$PESOTOT
# Normalização dos dados
x <- scale(x)
# Definindo o modelo DNN
model_keras <- keras_model_sequential()
model_keras %>%
layer_dense(units = 64, activation = 'relu', input_shape = dim(x)[2]) %>%
layer_dense(units = 64, activation = 'relu') %>%
layer_dense(units = 1)
# Compilando modelo
model_keras %>% compile(
optimizer = optimizer_rmsprop(),
loss = 'mse',
metrics = c('mae')
)
# Treinamento
history <- model_keras %>% fit(
x, y,
epochs = 100,
validation_split = 0.2, # Split treinamento/validação
verbose = 0
)
# Desempenho do modelo
metrics <- model_keras %>% evaluate(x, y)## 522/522 - 1s - loss: 224620032.0000 - mae: 4430.2363 - 562ms/epoch - 1ms/step
## [1] "Mean Absolute Error (MAE): 4430.236328125"
## [1] "Mean Squared Error (MSE): 224620032"
## loss mae
## 2.246200e+08 4.430236e+03
# Análise Comparativa
# Predições realizadas (Para ranking)
predicoes_PESOTOT <- model_keras %>% predict(x)## 522/522 - 1s - 509ms/epoch - 975us/step
# Df pred/real
comparativo_PESOTOT <- data.frame(Previsoes = predicoes_PESOTOT, Real = y)
# Dispersão
plot(comparativo_PESOTOT$Real, comparativo_PESOTOT$Previsoes,
xlab = c("RDPC Real", metrics),
ylab = "Previsões do Modelo",
main = "Comparação entre Previsões e Valores Reais")# Keras RDPC (Ranking dos Municípios)
df_ranked$Pred_PESOTOT_Rnk <- predicoes_PESOTOT
summary(predicoes_PESOTOT)## V1
## Min. : 2366
## 1st Qu.: 8293
## Median : 11962
## Mean : 31398
## 3rd Qu.: 19742
## Max. :12459874
# Setup
x_Arima_Prdct <- Arima_Prdct[, c("AREA_KM2", "KM_DIST_CAP", "ESPVIDA",
"FECTOT", "T_ENV", "GINI","PIND",
"RDPC","PESO15", "DEM_DEMO","TXDSEMP")]
x_Arima_Prdct <- scale(x_Arima_Prdct)
# Previsões
predicoes_PESOTOT_Arima_Prdct <- model_keras %>% predict(x_Arima_Prdct)## 174/174 - 0s - 166ms/epoch - 954us/step
x <- df_keras[, c("AREA_KM2", "KM_DIST_CAP", "ESPVIDA", "FECTOT", "T_ENV",
"GINI", "PIND","RDPC","PESO15","PESOTOT","TXDSEMP")]
y <- df_keras$DEM_DEMO
x <- scale(x)
model_keras <- keras_model_sequential()
model_keras %>%
layer_dense(units = 64, activation = 'relu', input_shape = dim(x)[2]) %>%
layer_dense(units = 64, activation = 'relu') %>%
layer_dense(units = 1)
model_keras %>% compile(
optimizer = optimizer_rmsprop(),
loss = 'mse',
metrics = c('mae')
)
history <- model_keras %>% fit(
x, y,
epochs = 100,
validation_split = 0.2, # Split treinamento/validação
verbose = 0
)
metrics <- model_keras %>% evaluate(x, y)## 522/522 - 1s - loss: 128816.3750 - mae: 65.6592 - 562ms/epoch - 1ms/step
## [1] "Mean Absolute Error (MAE): 65.6592407226562"
## [1] "Mean Squared Error (MSE): 128816.375"
## loss mae
## 128816.37500 65.65924
## 522/522 - 1s - 518ms/epoch - 991us/step
comparativo_DEM_DEMO <- data.frame(Previsoes = predicoes_DEM_DEMO, Real = y)
plot(comparativo_DEM_DEMO$Real, comparativo_DEM_DEMO$Previsoes,
xlab = c("RDPC Real", metrics),
ylab = "Previsões do Modelo",
main = "Comparação entre Previsões e Valores Reais")# Keras RDPC (Ranking dos Municípios)
df_ranked$Pred_DEM_DEMO_Rnk <- predicoes_DEM_DEMO
df_ranked$TXDSEMP <- df_keras$TXDSEMP
summary(predicoes_DEM_DEMO)## V1
## Min. : -237.547
## 1st Qu.: 4.151
## Median : 26.610
## Mean : 102.108
## 3rd Qu.: 60.777
## Max. :19078.803
# Setup
x_Arima_Prdct <- Arima_Prdct[, c("AREA_KM2", "KM_DIST_CAP", "ESPVIDA",
"FECTOT", "T_ENV", "GINI","PIND","PESO15",
"PESOTOT","DEM_DEMO","TXDSEMP")]
x_Arima_Prdct <- scale(x_Arima_Prdct)
# Previsões
predicoes_DEM_DEMO_Arima_Prdct <- model_keras %>% predict(x_Arima_Prdct)## 174/174 - 0s - 176ms/epoch - 1ms/step
Comparação do predito para 2020:
Clique acima para selecionar qual deseja visualizar.
Organizando Data Frames:
## [1] FALSE
# Predições de ARIMA para 2020.
A_ARIMA_20 <- round(Arima_Prdct[,c(8,10,11)],2)
colnames(A_ARIMA_20)[1] <- "RDPC"
colnames(A_ARIMA_20)[2] <- "PESOTOT"
colnames(A_ARIMA_20)[3] <- "DEM_DEMO"
# Predições de Keras para 2020.
A_KERAS_20 <- round(Arima_Prdct[, c(13,14,15)],2)
colnames(A_KERAS_20)[1] <- "RDPC"
colnames(A_KERAS_20)[2] <- "PESOTOT"
colnames(A_KERAS_20)[3] <- "DEM_DEMO"Os filtos selecionaram aqueles municípios onde a previsão de ambos modelos concordam 20% de variação. Isto é entre 0.8 e 1.2, sendo 1 uma concordância perfeita. Neste tópico o amostral dos municípios candidatos é expressado de forma gráfica, onde as duas linhas vermelhas representam o intervalo considerado do filtro aplicado.
Clique acima para selecionar qual deseja visualizar.
hist(Ar_Vs_Kr$RDPC,
breaks = 200,
xlim = c(0, 2),
ylab = "Frequência",
xlab = "Variação",
main = "Histograma de renda per capita em 2020: Arima VS Keras")
abline(v = 0.8, col = "red", lty = 2)
abline(v = 1.2, col = "red", lty = 2) Consolidando Data Frames, nele consta:
# RENOMEANDO KERAS
An_KERAS_20 <- data.frame(A_KERAS_20)
An_ARIMA_20 <- data.frame(A_ARIMA_20)
An_Mean_20 <- (An_ARIMA_20 + An_KERAS_20) / 2
colnames(An_Mean_20)[1] <- "AxK_Mean_R"
colnames(An_Mean_20)[2] <- "AxK_Mean_P"
colnames(An_Mean_20)[3] <- "AxK_Mean_D"
An_Mean_20 <- round(An_Mean_20,2)
## FILTRO
# Identificação
decisao <- df_2010[, c(1,3,4,5)]
# Ar_Vs_Kr: Filtro
# AxK_Mean: Estável
decisao <- cbind(decisao, Ar_Vs_Kr)
decisao <- cbind(decisao, An_Mean_20)Filtro: seleciona os municípios onde a concordância das previsões entre ARIMA e Keras são de 20% de diferença. Ou 0.8 e 1.2, sendo 1 a concordância exata de predição.
Clique acima para selecionar qual deseja visualizar.
# Considerar apenas os dados que estão entre o primeiro e terceiro quartil
paste("Há",nrow(decisao),"potenciais municípios. Os filtros são as 'margens de segurança' onde há concordância entre a previsão dos dois modelos. São municípios que se encontram em 0.8 e 1.2 de previsão 'em comum' entre os modelos ARIMA e Keras. Em outras palavras, os 'municípios que tiveram previsão similar' (sendo 1 exata, e considerado variação de 20% acima ou abaixo).")## [1] "Há 5565 potenciais municípios. Os filtros são as 'margens de segurança' onde há concordância entre a previsão dos dois modelos. São municípios que se encontram em 0.8 e 1.2 de previsão 'em comum' entre os modelos ARIMA e Keras. Em outras palavras, os 'municípios que tiveram previsão similar' (sendo 1 exata, e considerado variação de 20% acima ou abaixo)."
filtro1 <- subset(decisao, RDPC >= 0.8 & RDPC <= 1.2)
paste("Aplicando primeiro filtro restam:",nrow(filtro1),"potenciais lugares. Foram removidos",nrow(decisao) - nrow(filtro1),"municípios.")## [1] "Aplicando primeiro filtro restam: 3329 potenciais lugares. Foram removidos 2236 municípios."
filtro2 <- subset(filtro1, PESOTOT >= 0.8 & PESOTOT <= 1.2)
paste("Aplicando segundo filtro restam:",nrow(filtro2),"potenciais lugares. Foram removidos",nrow(filtro1) - nrow(filtro2),"municípios.")## [1] "Aplicando segundo filtro restam: 1398 potenciais lugares. Foram removidos 1931 municípios."
filtro3 <- subset(filtro2, DEM_DEMO >= 0.8 & DEM_DEMO <= 1.2)
paste("Aplicando terceiro filtro restam:",nrow(filtro3),"potenciais lugares. Foram removidos",nrow(filtro2) - nrow(filtro3),"municípios.")## [1] "Aplicando terceiro filtro restam: 201 potenciais lugares. Foram removidos 1197 municípios."
Ao aplicar os filtros, de 5565 candidatos nos restam
201 municípios em que Keras e ARIMA concordam com uma
margem de 20%.
A partir desses resultados foi hipotetizado como sugestão dois perfis:
Clique acima para selecionar qual deseja visualizar.
Para o varejo que tem perfil de venda com alta margem de lucro (tendo em vista população com alto poder aquisitivo).
A abordagem exposta partiu da premissa que certos fatores são determinantes no sucesso de um empreendimento no varejo. Enquanto outros simplesmente têm pouca relevância ou nenhuma.
O estudo realizado não buscou provar a afirmativa anterior. Mas imaginar um cenário que essa premissa seja real. Dessa forma, possibilitando mensurar variáveis e estipular melhores marcadores para o sucesso deste negócio. E, por fim, uma indicação de localização para futuros estudos acerca de identificar municípios promissores para abertura de um novo empreendimento.
Os dados considerados relevantes foram: extensão territorial, distância da capital, esperança de vida, taxa de fecundidade total, taxa de envelhecimento, índice de Gini, índice da população em vulnerabilidade econômica, população de 15 anos ou mais e taxa de desemprego. Neste contexto, foi enfatizado as variáveis: renda per capita, população residente total e densidade demográfica.
A análise foi realizada a partir de modelos que partem de pressupostos distintos. Assim, tendo como objetivo, fornecer predições mais robustas. Implicando, de certa forma, uma “concordância” dentre o que foi predito pelos modelos.
Posteriormente sendo elaborado filtros como “margens de segurança” dessa “concordância” dos modelos. Que, em outras palavras, significa “os municípios que tiveram previsões correlatas”. As margens de segurança foram 20%. O primeiro filtro é renda per capita, o segundo população residente total e o terceiro densidade demográfica.
Partindo de 5565 potenciais municípios. Aplicando
primeiro filtro restaram 3329 candidatos. 1398
no segundo filtro. Por fim, restando 201 potenciais
municípios.
Concluiu-se que foi possível sugerir preliminarmente dois perfis: Um buscando poucas vendas com alta margem de lucro; e outro buscando alta recorrência de venda. Os três indicados em cada perfil, foram:
1:
… para perfis de alta renda.
2:
… para perfis de alta rotatividade.